home *** CD-ROM | disk | FTP | other *** search
/ Software of the Month Club 1996 November / Software of the Month Club 1996 November.iso / pc / dos / edu / activem / wplot.bas < prev   
Encoding:
BASIC Source File  |  1995-01-01  |  27.9 KB  |  599 lines
  1. 10   REM *** WPLOT by John Calder, Box 41-076, Auckland 3, NEW ZEALAND      ***
  2. 20   REM *** phone 0064 - 9 - 828 2612 (Auckland 828 2612 or 3784160)       ***
  3. 32   '
  4. 33   '***    1st Dec 1995 - own text processor routine lines 24000 on
  5. 34   '***    gives more friendly input. Also response to [Esc]
  6. 60   '
  7. 70   DEFINT F-N
  8. 80   REM Reserve space for windows effect
  9. 90   DIM WGRSAVE%(12000), WCURSOR%(100)
  10. 95   DIM LENFIELD(14), DINPUT$(14, 29), DLINE$(28)
  11. 100  '
  12. 128   INSFLAG = 1 : KSOUND = 1
  13. 145   FOR J = 1 TO 24: DLINE$(J) = " ": NEXT J
  14. 180    KEY OFF
  15. 200    REM Set up function keys
  16. 210       KEY 1, " HELP" + CHR$(13)
  17. 220       KEY 2, "plot(1, 1)"
  18. 230       KEY 3, " EXIT" + CHR$(13)    ' note 29/6/94 the space at the front
  19. 235       KEY 4, " DEMOs" + CHR$(13)   ' of these for better response from the
  20. 240       KEY 5, " CLEAR" + CHR$(13)   ' ERROR window, "press key to cont" bizzo
  21. 260       KEY 6, "line(0,0)-(5,5)"
  22. 270       KEY 7, "circle(3, 3),4"
  23. 280       KEY 8, "~"
  24. 290       KEY 9, "|"
  25. 300      KEY 10, "graphs" + CHR$(13)
  26. 5000   REM Set up limits for simplified graph
  27. 5005   ON ERROR GOTO 6100
  28. 5010      SCREEN 9
  29. 5012      ECC = .7: EGAFLAG$ = "YES": PL% = &HFFFF
  30. 5015      CLS
  31. 5017   ON ERROR GOTO 6000
  32. 5020   WINDOW (-6.9, -4.75)-(9.100001, 7.75)
  33. 5022   COLOR 15
  34. 5025   LINE (-6.9, 7.75)-(-6.7, 7.25), , BF
  35. 5030   GET (-6.9, 7.75)-(-6.7, 7.25), WCURSOR%
  36. 5040   COLOR 7: COLOR 14: PRINT "F1";
  37. 5041   COLOR 7: PRINT "="; : COLOR 14: PRINT "H";
  38. 5042   COLOR 7: PRINT "ELP";
  39. 5050   COLOR 14: PRINT "  F2";
  40. 5051   COLOR 7: PRINT "="; : COLOR 14: PRINT "plot";
  41. 5060   COLOR 14: PRINT "   F3";
  42. 5061   COLOR 7: PRINT "="; : COLOR 14: PRINT "E";
  43. 5062   COLOR 7: PRINT "XIT";
  44. 5063   COLOR 14: PRINT "  F4";
  45. 5064   COLOR 7: PRINT "="; : COLOR 14: PRINT "DEMOs";
  46. 5065   COLOR 14: PRINT "  F5";
  47. 5067   COLOR 7: PRINT "="; : COLOR 14: PRINT "C";
  48. 5068   COLOR 7: PRINT "LEAR";
  49. 5070   COLOR 14: PRINT "   F6";
  50. 5072   COLOR 7: PRINT "="; : COLOR 14: PRINT "line";
  51. 5075   COLOR 14: PRINT "  F7";
  52. 5077   COLOR 7: PRINT "="; : COLOR 14: PRINT "circle";
  53. 5080   LOCATE 3, 1
  54. 5085   COLOR 14: PRINT "F8";
  55. 5087   COLOR 7: PRINT "="; : COLOR 14: PRINT "clear line";
  56. 5090   COLOR 14: PRINT "   F9";
  57. 5092   COLOR 7: PRINT "="; : COLOR 14: PRINT "copy line";
  58. 5095   COLOR 14: PRINT "   F10";
  59. 5096   COLOR 7: PRINT "="; : COLOR 14: PRINT "graphs of equations";
  60. 5097   COLOR 14: PRINT "   s";
  61. 5098   COLOR 7: PRINT "="; : COLOR 14: PRINT "sound off/on";
  62. 5099   '
  63. 5100   REM Set up grid lines
  64. 5105   COLOR 3
  65. 5110   FOR Y = -4 TO 7
  66. 5130      LINE (-6.9, Y)-(9.100001, Y), , , PL%
  67. 5140   NEXT Y
  68. 5150   FOR X = -6 TO 8
  69. 5160       LINE (X, -4.75)-(X, 7.75), , , PL%
  70. 5180   NEXT X
  71. 5190   REM
  72. 5200   REM start of graph axes draw
  73. 5205   COLOR 11
  74. 5210   REM set up axes
  75. 5220      LINE (-6.9, 0)-(9.100001, 0)
  76. 5230      IF EGAFLAG$ = "YES" THEN LINE (0, -4.75)-(0, 7.75) ELSE LINE (0, -4.75)-(0, 7.75), , , &HFEFE
  77. 5250   REM Axes labels go here
  78. 5255   TEXTLINE = 0
  79. 5260   FOR YLABEL = 7 TO 1 STEP -1
  80. 5265      TEXTLINE = TEXTLINE + 2
  81. 5270      LOCATE TEXTLINE, 33: PRINT STR$(YLABEL)
  82. 5275   NEXT YLABEL
  83. 5290   LOCATE 16, 35: PRINT "0"
  84. 5300   COLUMN = 0
  85. 5301   FOR XLABEL = -6 TO -1
  86. 5302      COLUMN = COLUMN + 5
  87. 5303      LOCATE 16, COLUMN - 2: PRINT " " + STR$(XLABEL)
  88. 5304   NEXT XLABEL
  89. 5310   COLUMN = 34
  90. 5311   FOR XLABEL = 1 TO 8
  91. 5312      COLUMN = COLUMN + 5
  92. 5313      LOCATE 16, COLUMN: PRINT STR$(XLABEL)
  93. 5314   NEXT XLABEL
  94. 5320   FOR YLABEL = -1 TO -4 STEP -1
  95. 5322      TEXTLINE = 16 - 2 * YLABEL
  96. 5323      LOCATE TEXTLINE, 32: PRINT " "; STR$(YLABEL);
  97. 5325   NEXT YLABEL
  98. 5330   IF DEMOFLAG$ = "YES" THEN DEMOFLAG$ = "NO": GOTO 10300
  99. 5332   COLOR 11: LOCATE 15, 1: PRINT "DRAW-BY-PLOT" ;
  100. 5335   LOCATE 17, 1: PRINT "Enter your command below" ;
  101. 5340   FOR F = 1 TO 14: FOR J = 1 TO 29: DINPUT$(F, J) = " ": NEXT J: NEXT F
  102. 5342   LOCATE 25, 1
  103. 5344   IF INSFLAG=1 THEN PRINT"[ INSERT active ]";:ELSE PRINT"[ INSERT off ]    ";
  104. 5350   COLOR 14: F = 9
  105. 5400 '********** start of main input routine *******************************
  106. 5410   KCOL = 1: LENFIELD(F) = 1
  107. 5420   GOSUB 24000
  108. 5428   IF HELPFLAG% = 1 THEN PUT (1.5, -3.75), WGRSAVE%, PSET: HELPFLAG% = 0
  109. 5458   '*** now for some answer analysis
  110. 5470   IF FUNCTION$ = "S" + SPACE$(27) THEN 6300   '**** sound on or off
  111. 5472   IF INSTR(FUNCTION$, "PLAY")=0 AND KSOUND=1 THEN PLAY "MBo4l16cdefefef"
  112. 5475   IF INSTR(FUNCTION$, "DEMO") > 0 THEN 10000
  113. 5476   IN3$ = LEFT$(FUNCTION$, 1)
  114. 5478   IF IN3$ = "H" THEN 8000
  115. 5480   IF INSTR(FUNCTION$, "HELP") > 0 THEN 8000
  116. 5483   IF INSTR(FUNCTION$, "EXIT") > 0 THEN 9100
  117. 5484   IF INSTR(FUNCTION$, "CLEAR") > 0 THEN CLS : GOTO 5020
  118. 5485   IF INSTR(FUNCTION$, "///") > 0 THEN SCREEN 8: ECC = .4: GOTO 5020
  119. 5486   IF INSTR(FUNCTION$, "GUIDE") > 0 THEN GOTO 9500
  120. 5487   IF INSTR(FUNCTION$, "CGA") > 0 THEN SCREEN 2: ECC = .4: EGAFLAG$ = "NO": PL% = &HF0F0: GOTO 5020
  121. 5490   IF INSTR(FUNCTION$, "GRAPH") > 0 THEN GOTO 9600
  122. 5500 '**** Command analysis and execution *****
  123. 5502 '
  124. 5506 '**** fix behaviour of PRINT
  125. 5510     P% = INSTR(FUNCTION$, "PRINT") : P2% = INSTR(FUNCTION$, "?")
  126. 5520     IF P% = 0 AND P2% = 0 THEN GOTO 5550
  127. 5530     FUNCTION$ = "PRINT: " + FUNCTION$ : IF F<14 THEN F = F + 1
  128. 5540     GOTO 5700
  129. 5550 '**** analysis and sorting of CIRCLE command   
  130. 5553     P% = INSTR(FUNCTION$, "CIRCLE")
  131. 5557     IF P% = 0 THEN GOTO 5600
  132. 5560     FC$ = FUNCTION$: PCOMMA% = 0
  133. 5562     FOR NCOMMA% = 0 TO 5
  134. 5564        PCOMMA% = INSTR(PCOMMA% + 1, FUNCTION$, ",")
  135. 5567        IF PCOMMA% = 0 THEN GOTO 5580
  136. 5570     NEXT NCOMMA%
  137. 5575     FUNCTION$ = LEFT$(FUNCTION$, PPREV%) + STR$(VAL(MID$(FUNCTION$, PPREV% + 1)) * ECC): GOTO 5700
  138. 5580     FOR I% = 1 TO 6 - NCOMMA%
  139. 5585        FUNCTION$ = FUNCTION$ + ","
  140. 5590     NEXT I%
  141. 5593 '   And the climax of 5500-5600 is the eccentricity correction
  142. 5595     FUNCTION$ = FUNCTION$ + STR$(ECC)
  143. 5597     GOTO 5700
  144. 5600 '***     Customised PLOT command is more like familiar maths than the
  145. 5610 '        standard PSET
  146. 5620     P% = INSTR(FUNCTION$, "PLOT")
  147. 5682     IF P% = 0 THEN GOTO 5700
  148. 5684         FUNCTION$ = "PSET" + MID$(FUNCTION$, P% + 4)
  149. 5686         OPEN "O", #1, "FUNCTION.BAS"
  150. 5687         F$ = "5690 " + "ON ERROR GOTO 6000: WINDOW(-6.9,-4.75)-(9.1, 7.75) :" + FUNCTION$
  151. 5688         PRINT #1, F$: CLOSE #1
  152. 5689         CHAIN MERGE "FUNCTION.BAS" ,5690,ALL
  153. 5690 ON ERROR GOTO 6000: WINDOW(-6.9,-4.75)-(9.100001, 7.75) :PSET(1, 1)                  
  154. 5692         X = POINT(2): Y = POINT(3)
  155. 5694         LINE (X - .15, Y - .15)-(X + .15, Y + .15)
  156. 5695         LINE (X + .15, Y - .15)-(X - .15, Y + .15)
  157. 5696         GOTO 5400
  158. 5698    'END of routine for plotting a clearer point
  159. 5699    '
  160. 5700     OPEN "O", #1, "FUNCTION.BAS"
  161. 5710     F$ = "5750 " + "ON ERROR GOTO 6000 : WINDOW(-6.9,-4.75)-(9.1,7.75) : " + FUNCTION$
  162. 5720     PRINT #1, F$
  163. 5730     CLOSE #1
  164. 5740     CHAIN MERGE "FUNCTION.BAS" ,5750,ALL
  165. 5750 ON ERROR GOTO 6000 : WINDOW(-6.9,-4.75)-(9.100001,7.75) : PAINT(5,4),"ROD",14         
  166. 5760 GOTO 5400
  167. 5770 REM hard lesson learned on preserving variables 21/8/92
  168. 5771 REM in CHAIN MERGE filename,linenumber,ALL <-- is vital!
  169. 5772 '
  170. 6000 '**** 6000-7000 Command error handlers and management routines
  171. 6010     IF ERR = 5 THEN RESUME NEXT
  172. 6012     IF ERL = 5690 OR ERL = 5750 THEN RESUME 8700
  173. 6015     IF ERR = 70 THEN RESUME 6200
  174. 6020     CLS : PRINT
  175. 6030     PRINT "Exit due to error "; ERR; " at line "; ERL
  176. 6040     PRINT
  177. 6050     PRINT "Please note these values and tell us about it"
  178. 6060     PRINT
  179. 6070     PRINT "Press any key to exit from this unhappy state of affairs"
  180. 6075     PRINT "and it should be safe to re-start and continue with your work."
  181. 6080     AK$ = INKEY$: IF AK$ = "" THEN 6080
  182. 6085     SYSTEM
  183. 6090 '
  184. 6100 '*** Graphics screen availability response
  185. 6110     SCREEN 2
  186. 6120     ECC = .4: PL% = &HF0F0
  187. 6140     RESUME 5015
  188. 6150 '
  189. 6200 '*** Response to disk write-protected
  190. 6201 '    start with saving the screen graphics display
  191. 6220 GET (1.5, 1.25)-(8.3, -3.75), WGRSAVE%
  192. 6230 LINE (1.5, 1.25)-(8.3, -3.75), 4, BF
  193. 6250    LOCATE 15, 44:              PRINT " ERROR - disk 'write-protected' "
  194. 6252    LOCATE 16, 44:              PRINT "                                "
  195. 6253    LOCATE 17, 44:              PRINT " Please remove the disk and     "
  196. 6254    LOCATE 18, 44:              PRINT " slide the little cover over    "
  197. 6255    LOCATE 19, 44:              PRINT " the hole in the corner.        "
  198. 6256    LOCATE 20, 44:              PRINT "                                "
  199. 6257    LOCATE 21, 44:              PRINT " Then put the disk back in and  "
  200. 6258    LOCATE 22, 44:           :  PRINT " press ENTER key to continue... "
  201. 6260 AK$ = INKEY$: IF AK$ = "" THEN 6260
  202. 6270 PUT (1.5, -3.75), WGRSAVE%, PSET '*** restore screen to its former glory
  203. 6280 LOCATE ILINE%, 1: GOTO 5400
  204. 6290 '
  205. 6300 '*** toggle sound, KSOUND=1 for ON , =0 for OFF , new 1-1-95
  206. 6310  IF KSOUND=1 THEN 6350
  207. 6320      KSOUND = 1
  208. 6330      LOCATE CSRLIN,1 : PRINT "SOUND ON                    " ;
  209. 6335      PLAY "MBo4l16cdefefef"
  210. 6340  GOTO 5400
  211. 6350      KSOUND = 0
  212. 6360      LOCATE CSRLIN,1 : PRINT "SOUND OFF                   " ;
  213. 6370  GOTO 5400
  214. 8000 REM ****************** HELP routines *******************
  215. 8100 REM Create HELP window, start by saving graphics
  216. 8110 REM Area involved is TEXTLINES 14 to 23 COLS 47 to 78
  217. 8120 REM Corresponding SIMPLOT points are (1.5 , 1.25) - (8.3 , -3.75)
  218. 8200 REM start with saving the screen graphics display
  219. 8220 GET (1.5, 1.25)-(8.3, -3.75), WGRSAVE%
  220. 8230 LINE (1.5, 1.25)-(8.3, -3.75), 2, BF
  221. 8250    LOCATE 15, 44:              PRINT " FOR EXAMPLE: to plot points    "
  222. 8252    LOCATE 16, 44:              PRINT " plot(1,1)                      "
  223. 8253    LOCATE 17, 44:              PRINT " plot(-4, 3)                    "
  224. 8254    LOCATE 18, 44:              PRINT " plot(0.3, 1.7)                 "
  225. 8255    LOCATE 19, 44:              PRINT " FOR EXAMPLE: to draw lines     "
  226. 8256    LOCATE 20, 44:              PRINT " line(3,3)-(7,1)                "
  227. 8257    LOCATE 21, 44:              PRINT " line(-2,-2)-(4,-3)             "
  228. 8258    LOCATE 22, 44:           :  PRINT " press ENTER key to continue... "
  229. 8270 A$ = INKEY$: IF A$ = "" THEN 8270
  230. 8300    LOCATE 15, 44:              PRINT " CIRCLES: give centre and radius"
  231. 8301    LOCATE 16, 44:              PRINT " circle(0,0),1                  "
  232. 8302    LOCATE 17, 44:              PRINT " circle(4,4),2                  "
  233. 8303    LOCATE 18, 44:              PRINT " circle(-4.25,-3.1),2.75        "
  234. 8304    LOCATE 19, 44:              PRINT "                                "
  235. 8305    LOCATE 20, 44:              PRINT " Press Enter key to go to work.."
  236. 8306    LOCATE 21, 44:              PRINT " OR                             "
  237. 8307    LOCATE 22, 44:              PRINT " F1=more help   F4=DEMOs        "
  238. 8310 A$ = INKEY$: IF A$ = "" THEN 8310
  239. 8320 REM I want this window to stay on-screen as
  240. 8325 REM student makes first attempts
  241. 8330 HELPFLAG% = 1
  242. 8333    LOCATE 20, 44: COLOR 15: PRINT "                                "
  243. 8334    LOCATE 21, 44: COLOR 15: PRINT "                                "
  244. 8335    LOCATE 22, 44: COLOR 15: PRINT " NOW ENTER YOUR COMMAND...      "
  245. 8340 LOCATE HLINE%, 1: GOTO 5400
  246. 8700 REM *******SUBROUTINE for when students mis enter commands ************
  247. 8701 ON ERROR GOTO 6000    '*** refresh required after diversion here
  248. 8702 PLAY "MBo2l8FCDAGGGGo4BAGFE"
  249. 8703 REM start with saving the screen graphics display
  250. 8705 GET (1.5, 1.25)-(8.3, -3.75), WGRSAVE%
  251. 8707 LINE (1.5, 1.25)-(8.3, -3.75), 4, BF
  252. 8710    COLOR 14
  253. 8711    LOCATE 15, 44:              PRINT " Error message                  "
  254. 8712    LOCATE 16, 44:              PRINT "                                "
  255. 8713    LOCATE 17, 44:              PRINT " There is something wrong with  "
  256. 8714    LOCATE 18, 44:              PRINT " the setting-out of your command"
  257. 8715    LOCATE 19, 44:              PRINT "                                "
  258. 8716    LOCATE 20, 44:              PRINT " Please try again...            "
  259. 8717    LOCATE 21, 44:              PRINT "                                "
  260. 8718    LOCATE 22, 44: COLOR 15:    PRINT "PRESS ANY KEY TO CONTINUE       "
  261. 8740 A$ = INKEY$: IF A$ = "" THEN 8740
  262. 8750 HELPFLAG% = 1
  263. 8755    LOCATE 22, 44:           :  PRINT " Now enter your command...      "
  264. 8757    COLOR 14: LOCATE ILINE%, 1
  265. 8760 GOTO 5400
  266. 8790 '
  267. 8990 ' ************** END of HELP routines ****************
  268. 8995 '
  269. 9000 ' **********SCREEN CLEAR and EXIT routines ***********
  270. 9010 '
  271. 9020 '*** SCREEN CLEAR
  272. 9030 GOTO 5000
  273. 9090 REM
  274. 9100 REM  EXIT routine
  275. 9110 SCREEN 1: COLOR , 2
  276. 9120 PRINT
  277. 9130 PRINT "      EXITING from DRAW-BY-PLOT"
  278. 9160 T1 = TIMER
  279. 9165 IF TIMER - T1 < 2 THEN 9165
  280. 9200 SCREEN 0: WIDTH 80: SYSTEM
  281. 9500 '
  282. 9510 '*** call up guide screen
  283. 9520      SHELL "PAGER WPLOT.TXT"
  284. 9540      GOTO 5000
  285. 9600 '*******  SIMPLOT on F10
  286. 9650  COLOR 15 : LOCATE CSRLIN,1 : PLAY "MBl10o5co4bagfedc"
  287. 9660  PRINT "**** loading GRAPH PLOTTING programme ****";
  288. 9670  RUN "SIMPLOT"
  289. 10000 REM ****************** DEMO routines *******************
  290. 10100 REM Create DEMO intro window, although sim to HELP save graphics not req
  291. 10110 REM Area involved is TEXTLINES  9 to 20 COLS 42 to 78
  292. 10120 REM Corresponding WINDOW  points are (0.9 ,-2.75) - (8.9 , 4.3)
  293. 10230 LINE (.9, -2.75)-(8.899999, 4.3), 6, BF
  294. 10240 COLOR 11
  295. 10250    LOCATE 9, 42:               PRINT " DEMOs start simple and work up   "
  296. 10252    LOCATE 10, 42:              PRINT "                                  "
  297. 10253    LOCATE 11, 42:              PRINT "  1.  simple triangle             "
  298. 10254    LOCATE 12, 42:              PRINT "  2.  3 circles side-by-side      "
  299. 10255    LOCATE 13, 42:              PRINT "  3.  3 and 4 sided figures       "
  300. 10256    LOCATE 14, 42:              PRINT "  4.  winged trophy               "
  301. 10257    LOCATE 15, 42:              PRINT "  5.  circles inside circles      "
  302. 10258    LOCATE 16, 42:              PRINT "  6.  circles linked on diagonal  "
  303. 10259    LOCATE 17, 42:              PRINT "  7.  variable with a formula     "
  304. 10260    LOCATE 18, 42:              PRINT "  8.  music                       "
  305. 10261    LOCATE 19, 42:              PRINT "  9.  exit demo                   "
  306. 10262    LOCATE 20, 42:              PRINT " type 1..8  to choose your demo   "
  307. 10270 A$ = INKEY$: IF A$ = "" THEN 10270
  308. 10280 IA = VAL(A$) : IF IA > 0 THEN 10290 ELSE CLS : GOTO 5020
  309. 10290 IF IA<9 THEN CLS : DEMOFLAG$ = "YES": GOTO 5020
  310. 10300 ON VAL(A$) GOTO 11000, 12000, 13000, 14000, 15000, 16000, 17000, 18000, 19000
  311. 11000 '***** DEMO of simple triangle
  312. 11010 COLOR 11
  313. 11020    LOCATE 17, 1: PRINT "Run commands one at a time with Enter key"
  314. 11030 COLOR 14
  315. 11040    LOCATE 18, 1: PRINT "line(0,4)-(2,7)"
  316. 11050    LOCATE 19, 1: PRINT "line(2,7)-(9,1)"
  317. 11060    LOCATE 20, 1: PRINT "line(9,1)-(0,4)"
  318. 11070    LOCATE 21, 1: IF EGAFLAG$ = "YES" THEN PRINT "paint(5,3),12,14" ELSE PRINT "paint(5.1,3.1)"
  319. 11080 FSTART = 9: FSTOP = 12: GOSUB 20000
  320. 11200 GOTO 5400
  321. 12000 '***** DEMO of 3 circles side-by-side
  322. 12020    LOCATE 15, 1: PRINT "Run commands one at a time"
  323. 12030 COLOR 14
  324. 12040    LOCATE 17, 1: PRINT "circle(2,3),2"
  325. 12050    LOCATE 18, 1: PRINT "circle(6,3),2"
  326. 12060    LOCATE 19, 1: PRINT "circle(-2,3),2"
  327. 12070    LOCATE 20, 1: IF EGAFLAG$ = "YES" THEN PRINT "paint(-2,3),12,14" ELSE PRINT "paint(-2.1,3.1)"
  328. 12080    LOCATE 21, 1: IF EGAFLAG$ = "YES" THEN PRINT "paint(2,3),10,14" ELSE PRINT "paint(2.1,3.1)"
  329. 12090    LOCATE 22, 1: IF EGAFLAG$ = "YES" THEN PRINT "paint(6,3), 9,14" ELSE PRINT "paint(6.1,3.1)"
  330. 12100 FSTART = 8: FSTOP = 13: GOSUB 20000
  331. 12200 GOTO 5400
  332. 13000 '***** DEMO of 3 and 4-sided figures
  333. 13010 COLOR 11
  334. 13020    LOCATE 13, 1: PRINT "Run commands one at a time"
  335. 13030 COLOR 14
  336. 13040    LOCATE 14, 1: PRINT "line(-5,4)-(-5.5,7.5)"
  337. 13050    LOCATE 15, 1: PRINT "line(-5.5,7.5)-(-2,7)"
  338. 13060    LOCATE 17, 1: PRINT "line(-2,7)-(-5,4)"
  339. 13070    LOCATE 18, 1: PRINT "line(-4,5)-(4,-3)"
  340. 13080    LOCATE 19, 1: PRINT "line(4,-3)-(5,-2)"
  341. 13090    LOCATE 20, 1: PRINT "line(5,-2)-(-3,6)"
  342. 13100    LOCATE 21, 1: IF EGAFLAG$ = "YES" THEN PRINT "paint(-4,6),10,14" ELSE PRINT "paint(-4.1,6.1)"
  343. 13110    LOCATE 22, 1: IF EGAFLAG$ = "YES" THEN PRINT "paint(1,1),13,14" ELSE PRINT "paint(1.1,1.1)": LOCATE 23, 1: PRINT "paint(-1.1,3.1)"
  344. 13190 FSTART = 6: FSTOP = 13: GOSUB 20000
  345. 13300 GOTO 5400
  346. 14000 '***** DEMO of 'Winged Trophy'
  347. 14010 COLOR 11
  348. 14020    LOCATE 8, 1: PRINT "Run commands one at a time"
  349. 14030 COLOR 14
  350. 14040    LOCATE 9, 1: PRINT "circle(0,4),2"
  351. 14050    LOCATE 10, 1: PRINT "line(2,4)-(4,7)"
  352. 14060    LOCATE 11, 1: PRINT "line(4,7)-(7,0)"
  353. 14070    LOCATE 12, 1: PRINT "line(7,0)-(2,4)"
  354. 14080    LOCATE 13, 1: PRINT "line(-1,2.3)-(1,-3),14,b"
  355. 14090    LOCATE 14, 1: PRINT "line(-3,-3)-(3,-4),14,b"
  356. 14100    LOCATE 15, 1: PRINT "line(-2,4)-(-4,7)"
  357. 14110    LOCATE 17, 1: PRINT "line(-4,7)-(-7,0)"
  358. 14120    LOCATE 18, 1: PRINT "line(-7,0)-(-2,4)"
  359. 14200    LOCATE 19, 1: IF EGAFLAG$ = "YES" THEN PRINT "paint(-4,4),13,14" ELSE PRINT "paint(-4.1,5.1)"
  360. 14210    LOCATE 20, 1: IF EGAFLAG$ = "YES" THEN PRINT "paint(4,4),13,14" ELSE PRINT "paint(4.1,5.1)"
  361. 14220    LOCATE 21, 1: IF EGAFLAG$ = "YES" THEN PRINT "paint(0,4),12,14" ELSE PRINT "paint(0.1,4.1)"
  362. 14230    LOCATE 22, 1: IF EGAFLAG$ = "YES" THEN PRINT "paint(0,0), 9,14" ELSE PRINT "paint(0.1,0.1)"
  363. 14240    LOCATE 23, 1: IF EGAFLAG$ = "YES" THEN PRINT "paint(0,-3.5),11,14" ELSE PRINT "paint(0.1,-3.5)"
  364. 14300 COLOR 11
  365. 14320 LOCATE 18, 38: PRINT "Note the 'line' commands with extra  ,14,b"
  366. 14330 LOCATE 19, 38: PRINT "  b  stands for 'box'                     "
  367. 14340 LOCATE 20, 38: PRINT " 14  is the colour code for a yellow line "
  368. 14350 IF EGAFLAG$ = "YES" THEN GOTO 14400
  369. 14360 LOCATE 21, 38: PRINT "Your screen is black and white but you    "
  370. 14370 LOCATE 22, 38: PRINT "still need to be aware of the color code  ";
  371. 14380 LOCATE 23, 38: PRINT "space and at the very least give the      ";
  372. 14390 LOCATE 24, 38: PRINT "extra comma.                              ";
  373. 14400 FSTART = 1: FSTOP = 14: GOSUB 20000
  374. 14500 COLOR 14: GOTO 5400
  375. 15000 '***** DEMO of concentric circles
  376. 15010 COLOR 11
  377. 15020    LOCATE 11, 1: PRINT "Run commands one at a time"
  378. 15025    PRINT "using the Enter key"
  379. 15030 COLOR 14
  380. 15040    PRINT "circle(2,3),1"
  381. 15050    PRINT "circle(2,3),2"
  382. 15060    PRINT "circle(2,3),3"
  383. 15070    LOCATE 17, 1: PRINT "circle(2,3),4"
  384. 15080    PRINT "circle(2,3),5"
  385. 15100 IF EGAFLAG$ = "YES" THEN GOTO 15200
  386. 15110    LOCATE 19, 1: PRINT "paint(2.1,3.1)"
  387. 15120    PRINT "paint(4.5,3.1)"
  388. 15130    PRINT "paint(6.5,3.1)"
  389. 15150 GOTO 15300
  390. 15200    LOCATE 19, 1: PRINT "paint(2,3),12,14"
  391. 15210    PRINT "paint(3.5,3), 9,14"
  392. 15220    PRINT "paint(4.5,3),10,14"
  393. 15230    PRINT "paint(5.5,3), 6,14"
  394. 15240    PRINT "paint(6.5,3),11,14"
  395. 15290 FSTART = 5: FSTOP = 14: GOSUB 20000
  396. 15300 GOTO 5400
  397. 16000 '***** DEMO of dumb-bell shape
  398. 16010 COLOR 11
  399. 16020    LOCATE 14, 1: PRINT "Run commands one at a time"
  400. 16025                  PRINT "using the Enter key"
  401. 16030 COLOR 14
  402. 16050    LOCATE 17, 1: PRINT "circle(-4,5),2"
  403. 16060                  PRINT "circle(2,-1),3"
  404. 16070                  PRINT "line(-2.2,4.2)-(0.4,1.6)"
  405. 16080                  PRINT "line(-3.2,3.2)-(-0.6,0.6)"
  406. 16100 IF EGAFLAG$ = "YES" THEN GOTO 16200
  407. 16110    PRINT "paint(-4.1,5.1)"
  408. 16120    PRINT "paint(-1.1,2.1)"
  409. 16130    PRINT "paint(2.1,-1.1)"
  410. 16150    GOTO 16300
  411. 16200 '**** option for EGA and above available
  412. 16210    PRINT "paint(-4,5),10,14"
  413. 16220    PRINT "paint(-1,2),14,14"
  414. 16230    PRINT "paint(2,-1),10,14"
  415. 16290 FSTART = 8: FSTOP = 14: GOSUB 20000
  416. 16300 GOTO 5400
  417. 17000 '***** DEMO of variable substituted for in a formula
  418. 17001 COLOR 15
  419. 17002 LOCATE 5, 1
  420. 17003 PRINT "This demo gives a result as a number value after 4 steps, giving an example"
  421. 17004 PRINT "of the important Maths idea of using a VARIABLE in an EQUATION or FORMULA"
  422. 17005 PRINT "that you can then SUBSTITUTE VALUES for.                                 "
  423. 17006 PRINT SPACE$(60)
  424. 17007 PRINT "Here you have the FORMULA for area of a circle featuring the variable  r  "
  425. 17008 PRINT "Note that when the formula works out a VALUE for area, the answer stays"
  426. 17009 PRINT "inside the computer.   You will not see any result until you work through to"
  427. 17010 PRINT "the PRINT command which makes it come up on the screen."
  428. 17011 LOCATE 24, 1
  429. 17012 PRINT "On this system  *  is used for 'times' to avoid mix-ups with the letter x  ";
  430. 17013 LOCATE 25, 1
  431. 17014 PRINT "After your first run, change the 2 in r = 2 to other values and run again.";
  432. 17015 COLOR 10
  433. 17020    LOCATE 14, 1: PRINT "Run commands one at a time"
  434. 17025    PRINT "using the Enter key   "
  435. 17026    PRINT SPACE$(60)
  436. 17030 COLOR 14
  437. 17050    LOCATE 17, 1: PRINT "pi = 3.14159"
  438. 17060    PRINT "r = 2"
  439. 17070    IF EGAFLAG$ = "YES" THEN PRINT "area = pi * r"; CHR$(253) ELSE PRINT "area = pi * r^2"
  440. 17080    PRINT "print area"
  441. 17090 FSTART = 8: FSTOP = 11: GOSUB 20000
  442. 17200 GOTO 5400
  443. 18000 '***** music
  444. 18002 COLOR 15
  445. 18003 LOCATE 5, 1
  446. 18004 PRINT "This demo lets you experiment with playing music on the system.  "
  447. 18005 PRINT "It does not draw any shapes."
  448. 18006 PRINT "The first line plays a simple scale, but listen for the last  c  note "
  449. 18007 PRINT "going too low.  This is corrected in the following line by going up"
  450. 18008 PRINT "to the  c  in the next octave.  Unless you change octaves, the notes"
  451. 18009 PRINT "come from the middle of a keyboard.  The computer system calls this  o4 "
  452. 18010 PRINT "for OCTAVE 4 .                                                "
  453. 18011 PRINT "Notice how I get higher notes with  o5  and lower ones with  o2  and  o3  "
  454. 18012 PRINT "The  l  (for length) values control the length of notes.      "
  455. 18013 PRINT "Higher values like  l16  make for shorter notes that play faster music.    "
  456. 18015 COLOR 10
  457. 18020    LOCATE 17, 1: PRINT "Run commands one at a time with Enter key"
  458. 18030 COLOR 14
  459. 18040    LOCATE 18, 1: PRINT "play"; CHR$(34); "cdefgabc"; CHR$(34)
  460. 18050    LOCATE 19, 1: PRINT "play"; CHR$(34); "cdefgab o5 c"; CHR$(34)
  461. 18060    LOCATE 20, 1: PRINT "play"; CHR$(34); "dcdcfgababbb o5 c"; CHR$(34)
  462. 18070    LOCATE 21, 1: PRINT "play"; CHR$(34); "l16 dcdcfgabbb"; CHR$(34)
  463. 18080    LOCATE 22, 1: PRINT "play"; CHR$(34); "l12 dcdc o2 fgabbb o3 c"; CHR$(34)
  464. 18090 FSTART = 9: FSTOP = 13: GOSUB 20000
  465. 18200 GOTO 5400
  466. 19000 '***** EXIT DEMO
  467. 19010 CLS : GOTO 5020
  468. 19990 '
  469. 20000 '***** SUBROUTINE TO HANDLE pre-printed input
  470. 20010  FOR F = FSTART TO FSTOP
  471. 20020  IF F < 8 THEN KLINE = F + 8 ELSE KLINE = F + 9
  472. 20030  FOR J = 1 TO 28
  473. 20040     IA = SCREEN(KLINE, J): IF IA = 0 THEN IA = 32
  474. 20050     DINPUT$(F, J) = CHR$(IA)
  475. 20060  NEXT J
  476. 20070  NEXT F
  477. 20080  F = FSTART
  478. 20090  RETURN
  479. 20100  '
  480. 24000   REM ************ Start of screen input routine *****************
  481. 24460   IF F < 8 THEN KLINE = F + 8 ELSE KLINE = F + 9
  482. 24465   LOCATE KLINE, 1
  483. 24470   PUT (-6.9 + (KCOL - 1) * .2, 7.75 - KLINE * .5), WCURSOR%, XOR
  484. 24480   LOCATE KLINE, KCOL
  485. 24500   AK$ = INKEY$: IF AK$ = "" THEN 24500
  486. 24502   PUT (-6.9 + (KCOL - 1) * .2, 7.75 - KLINE * .5), WCURSOR%, XOR
  487. 24505   IA = ASC(AK$)
  488. 24510   IF IA >= 32 THEN 24550
  489. 24520       IF IA = 27 THEN 9100: REM 27 is ESCape key   *****************
  490. 24525       IF IA = 13 THEN 26000: REM input completed and checked on ENTER
  491. 24530       IF IA = 0 THEN 25000: REM arrow keys, insert, delete
  492. 24535       IF IA = 8 THEN 25500: REM Backspace key
  493. 24540       IF IA = 9 THEN F = F + 1: GOTO 24650: REM  Tab key
  494. 24545   GOTO 24000
  495. 24550   IF AK$ = "~" THEN 25950: REM F8 clear field line
  496. 24560   IF AK$ = "|" THEN 26400 '*** F9 for copy line
  497. 24600   IF INSFLAG = 1 THEN GOSUB 25700: LOCATE KLINE, KCOL  '*** insert procedure
  498. 24605       DINPUT$(F, KCOL) = AK$
  499. 24610       PRINT DINPUT$(F, KCOL);
  500. 24612       IF LENFIELD(F) < KCOL THEN LENFIELD(F) = KCOL
  501. 24615       KCOL = KCOL + 1
  502. 24620       IF KCOL > 28 THEN KCOL = 28
  503. 24640   REM **** return from subroutines handling tab and up/down arrow keys **
  504. 24650       IF F = 15 THEN F = 9
  505. 24660       IF F = 0 THEN F = 14
  506. 24760   GOTO 24000
  507. 24800  '**********
  508. 25000  REM ************** arrow and tab key analysis    ********************
  509. 25003  IF ASC(RIGHT$(AK$, 1)) = 77 THEN 24615: REM Right Arrow
  510. 25010  IF ASC(RIGHT$(AK$, 1)) = 75 THEN 25200: REM Left Arrow
  511. 25020  IF ASC(RIGHT$(AK$, 1)) = 80 THEN 25300: REM Down Arrow
  512. 25030  IF ASC(RIGHT$(AK$, 1)) = 72 THEN 25400: REM Up Arrow
  513. 25040  IF ASC(RIGHT$(AK$, 1)) = 15 THEN 25400: REM Shift Tab
  514. 25050  IF ASC(RIGHT$(AK$, 1)) = 71 THEN KCOL = 1: GOTO 24470  '*** Home arrow
  515. 25060  IF ASC(RIGHT$(AK$, 1)) = 79 THEN 25800: REM END arrow
  516. 25070  IF ASC(RIGHT$(AK$, 1)) = 83 THEN 25550: REM Delete key
  517. 25080  IF ASC(RIGHT$(AK$, 1)) = 82 THEN 25600: REM Insert key procedure & flag
  518. 25200  REM  *************        Left Arrow             ****************
  519. 25205       IF KCOL > 1 THEN KCOL = KCOL - 1
  520. 25220       GOTO 24470
  521. 25300  REM  *************    Down Arrow                 ****************
  522. 25310       F = F + 1
  523. 25320       GOTO 24650
  524. 25400  REM  *************    Up Arrow  or Shift Tab     ****************
  525. 25410       F = F - 1
  526. 25420       GOTO 24650
  527. 25500  REM  *************    Backspace Key - Delete comes in at 25550 *******
  528. 25510       IF KCOL = 1 THEN GOTO 24470
  529. 25515       KCOL = KCOL - 1
  530. 25520       LOCATE KLINE, KCOL
  531. 25550       FOR J = KCOL TO 28
  532. 25555       DINPUT$(F, J) = DINPUT$(F, J + 1): PRINT DINPUT$(F, J);
  533. 25560       NEXT J
  534. 25565       LENFIELD(F) = LENFIELD(F) - 1
  535. 25570       GOTO 24470
  536. 25600  REM  ****   Insert Key - main entry control flag and indicator ******
  537. 25610       IF INSFLAG = 1 THEN 25650
  538. 25615       INSFLAG = 1
  539. 25620       LOCATE 25, 1: PRINT "[ INSERT active ]";
  540. 25630       GOTO 24470
  541. 25650       INSFLAG = 0
  542. 25660       LOCATE 25, 1: COLOR 15: PRINT "[ insert OFF    ]";
  543. 25670       GOTO 24470
  544. 25700  REM  *****  Insert Key - text shift sub to ref from main sequence ***
  545. 25740       LFLAG = 0
  546. 25750       FOR J = 28 TO KCOL + 1 STEP -1
  547. 25755       DINPUT$(F, J) = DINPUT$(F, J - 1)
  548. 25756       IF DINPUT$(F, J) <> " " THEN LFLAG = 1
  549. 25757       LOCATE KLINE, J: PRINT DINPUT$(F, J);
  550. 25760       NEXT J
  551. 25770       IF LFLAG = 1 THEN LENFIELD(F) = LENFIELD(F) + 1
  552. 25790       RETURN  '*** TO 24700
  553. 25800  REM  *************    END Arrow                 ****************
  554. 25805       IF LENFIELD(F) > 27 THEN LENFIELD(F) = 27
  555. 25807       IF LENFIELD(F) < 1 THEN LENFIELD(F) = 1
  556. 25810       KCOL = LENFIELD(F) + 1
  557. 25820       GOTO 24470
  558. 25830  REM
  559. 25950  REM  *************    CLEAR field line      ****************
  560. 25960       FOR J = 1 TO 28: DINPUT$(F, J) = " ": NEXT J
  561. 25980       LOCATE KLINE, 1: PRINT SPACE$(28)
  562. 25985       LENFIELD(F) = 1
  563. 25995       GOTO 24460
  564. 26000   '******* finish this input routine by analysing the          *****
  565. 26001   '******* individual DINPUT$ characters then assembling them  *****
  566. 26002   '******* into FUNCTION$ via assembly process array DLINE$()  *****
  567. 26020   FUNCTION$ = ""
  568. 26030   FOR I = 1 TO 28
  569. 26050      '*** IF DINPUT$(F, I) = " " THEN 26150
  570. 26100      KCHR = ASC(DINPUT$(F, I))
  571. 26110      IF KCHR >= 97 AND KCHR <= 122 THEN KCHR = KCHR - 32
  572. 26113      IF KCHR = 91 OR KCHR = 123 THEN KCHR = 40
  573. 26117      IF KCHR = 93 OR KCHR = 125 THEN KCHR = 41
  574. 26120      DLINE$(I) = CHR$(KCHR)
  575. 26130      IF DLINE$(I) = "²" THEN DLINE$(I) = "^2"
  576. 26135      IF INSTR("XST(", DLINE$(I)) <> 0 THEN GOSUB 26291  '*** PLAY ref
  577. 26140   FUNCTION$ = FUNCTION$ + DLINE$(I)
  578. 26150   NEXT I
  579. 26170   FPREV = F: F = F + 1: KCOL = 1: IF F = 15 THEN F = 9
  580. 26190   RETURN
  581. 26200   '
  582. 26290 REM **** SUBROUTINE FOR mx ---> m*x   ********
  583. 26291      J = I - 1: IF J = 0 THEN RETURN
  584. 26292      IF DLINE$(J) = " " THEN 26293 ELSE 26294
  585. 26293      J = J - 1: IF J = 0 THEN RETURN ELSE 26292
  586. 26294      IF INSTR("1234567890)X", RIGHT$(DLINE$(J), 1)) = 0 THEN RETURN
  587. 26295      DLINE$(I) = "*" + DLINE$(I)
  588. 26296 RETURN
  589. 26300 '
  590. 26400 '******* SUBROUTINE for COPY LINE on F9  *****
  591. 26410 LOCATE KLINE, 1: PRINT SPACE$(28); : LOCATE KLINE, 1
  592. 26420 FOR I = 1 TO 28
  593. 26430 DINPUT$(F, I) = DINPUT$(FPREV, I): PRINT DINPUT$(F, I);
  594. 26440 NEXT I
  595. 26450 LENFIELD(F) = LENFIELD(FPREV)
  596. 26455 IF LENFIELD(F) > 23 THEN LENFIELD(F) = 23
  597. 26460 KCOL = LENFIELD(F) + 1
  598. 26470 GOTO 24470
  599.